perm filename BUILTC.NEW[1,JRA]2 blob sn#030160 filedate 1973-03-16 generic text, type T, neo UTF8

(DEFPROP BUILTCH 
 (LAMBDA(X)
  (PROG (Z)
	(SETQ PFLG T)
	(SETQ Z (BUILTCH1 X))
	(RETURN
	 (COND ((OR (ATOM Z) (EQUAL Z (QUOTE (AND))) (EQUAL X (QUOTE (OR)))) NIL)
	       (T (LIST (QUOTE LAMBDA) (QUOTE (C1 C2)) Z)))))) 
EXPR)

(DEFPROP BUILTCH1 
 (LAMBDA(X)
  (COND ((ATOM X)
	 (COND ((EQ X (QUOTE ANCESTRY)) (SETQ ANCESTRY T) NIL)
	       ((EQ X (QUOTE NONE)) NIL)
	       ((MEMQ X (QUOTE (VINE ALLPOS ALLNEG UNIT)))
		(LIST (QUOTE OR) (LIST X (QUOTE C1)) (LIST X (QUOTE C2))))
	       (T X)))
	((EQ (CAR X) (QUOTE SUPPORT)) (SETSUP (CDR X)) (QUOTE (OR (SUPPORT C2) (SUPPORT C1))))
	((EQ (CAR X) (QUOTE MODEL)) (SETQ PMODEL (CADR X))
				    (SETQ NMODEL (CADDR X))
				    (QUOTE (OR (NOT (MODEL C1)) (NOT (MODEL C2)))))
	((EQ (CAR X) (QUOTE DEFMODEL))
	 (LIST (QUOTE OR)
	       (LIST (QUOTE NOT) (LIST (CDR X) (QUOTE C1)))
	       (LIST (QUOTE NOT) (LIST (CDR X) (QUOTE C2)))))
	((EQ (CAR X) (QUOTE ANCESTRY)) (SETQ ANCESTRY T) (BUILTCH1 (CDR X)))
	((ATOM (CAR X)) (CONS (BUILTCH1 (CAR X)) (BUILTCH1 (CDR X))))
	((EQ (CAAR X) (QUOTE EQUALITY)) (SETQ PFLG NIL)
					(SETQ EQUAL (CADAR X))
					(SETQ PDEPTH (CADDAR X))
					(BUILTCH1 (CDR X)))
	(T (CONS (BUILTCH1 (CAR X)) (BUILTCH1 (CDR X)))))) 
EXPR)